home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / ARexxGuide / ARx_Reg.rexx < prev    next >
OS/2 REXX Batch file  |  1994-03-21  |  8KB  |  256 lines
  1. /* $VER: 1.1    ARx_Reg.rexx by robin evans  (26 May 1993) */
  2. /*
  3. ** Produces a registration form and prompts user for input.
  4. ** Helpfully modified by Dean Adams. Thanks, Dean.
  5. */
  6.  
  7.  
  8. csi='9b'x;f.slant=csi'3m'; f.bold=csi'1m'; f.norm=csi'0m'
  9.              f.black=csi'31m'; f.white=csi'32m'; f.blue=csi'33m'
  10.              f.lf = '0a'x; f.cls = csi'0;0H'csi'J'
  11. /*
  12.  * NO CURSOR
  13.  */
  14. f.nc=csi'302070'x
  15.  
  16. signal on break_c
  17. signal on break_e
  18. signal on failure
  19.  
  20. options prompt f.blue||'::: 'f.black
  21. say f.blue'Setting up prompts...'f.black
  22.  
  23. NumPrompts = SetPrompts()
  24. Amount = $15.00
  25.  
  26. call writech STDOUT, f.cls
  27. do i = 1 to NumPrompts
  28.     say f.blue||PROMPT.i.6Prompt
  29.     say f.white'Please enter' PROMPT.i':'
  30.     parse pull Entry.i
  31. end
  32.  
  33.     say f.lf||f.white||f.cls'You entered:'||f.lf||f.black
  34.     do j = 1 to NumPrompts
  35.         call WordWrap Entry.j, 63, f.blue||right(j,2)'.)'f.black'  ', 6, 'STDOUT'
  36.         /*
  37.         DivPos = lastpos(' ', Entry.j' ', 62) + 1
  38.         say f.blue||right(j,2)'.)'f.black'   'left(Entry.j, DivPos)
  39.         do while DivPos <= length(Entry.j)
  40.             EndPos = lastpos(' ',Entry.j' ', DivPos + 63)
  41.             say '       'substr(Entry.j, DivPos, EndPos-DivPos)
  42.             DivPos = EndPos + 1
  43.         end
  44.         */
  45.     end
  46.  
  47.     do forever        /* Leave on result of prompt below */
  48.         say f.white'Would you like to change something? (Y/N)'
  49.         pull ChangeResp
  50.         if abbrev(ChangeResp, 'N') then leave
  51.         if abbrev(ChangeResp, 'Y') then do
  52.             say f.white||'Enter the number of the item to be changed:'
  53.             pull ChNum
  54.             if datatype(ChNum, N) & ChNum < NumPrompts then do
  55.                 say '            'Entry.ChNum
  56.                 say f.blue||PROMPT.ChNum.6Prompt
  57.                 say f.white'Please enter ' PROMPT.ChNum':'
  58.                 parse pull Entry.ChNum
  59.             end
  60.             else
  61.                 say 'Invalid input.'
  62.         end
  63.         else
  64.             say f.black'    Please enter Y or N'f.lf
  65.     end
  66.  
  67.     FileName = ''
  68.         /* Keep repeating the prompt until recognizable response is obtained */
  69.     do until verify(left(Dest,1), 'PFQ') = 0
  70.         say '0a'x'Save file to Printer or File?'
  71.         say 'Enter <P> for Printer or <F> for File.' f.blue'Enter <Q> to quit'
  72.  
  73.         pull Dest
  74.         if abbrev(Dest, 'P') then
  75.             FileName = 'PRT:'
  76.         else if abbrev(Dest, 'F') then
  77.             FileName = GetFile()
  78.                 /* Give the prompt again until the response is correct */
  79.     end
  80.     if FileName > '' then do
  81.             /* Save the information */
  82.         if open(6OFile, FileName, W) then do
  83.             call writeln(6OFile, f.bold||'      ARexxGuide registration.  Second edition.'f.norm)
  84.             call writeln(6OFile, '0a0a0a'x || '      Send this form and registration fee to')
  85.             call writeln(6OFile, copies(' ',40)'Robin Evans')
  86.             call writeln(6OFile, copies(' ',40)'1020 Seneca St. #405')
  87.             call writeln(6OFile, copies(' ',40)'Seattle WA  98101-2720')
  88.             call writeln(6OFile, '0a0a'x||copies(' ',6)'REGISTERED USER:')
  89.             do i = 1 to 7
  90.                 call writeln(6OFile, copies(' ',16)Entry.i)
  91.             end
  92.             call writeln(6OFile, '0a'x||copies(' ',6)'Enclosed is' Amount 'to register ARexxGuide.')
  93.             call writeln(6OFile, '0a0a'x||copies(' ',2)'MACHINE INFORMATION:')
  94.             do i = 8 to 11
  95.                 call writeln(6OFile, right(Prompt.i,31)'  'Entry.i)
  96.             end
  97.             parse version . Ver Proc .
  98.             if Proc = 68070 then Proc = 68040
  99.             call writeln(6OFile, right('Processor',31)'  'Proc)
  100.             call writeln(6OFile, '0a0a'x||copies(' ',4)'ARexx INFORMATION:')
  101.             call writeln(6OFile, right('ARexx version',31)'  'Ver)
  102.             do i = 13 to NumPrompts - 1
  103.                 call writeln(6OFile, right(Prompt.i,31)'  'Entry.i)
  104.             end
  105.             call writeln(6OFile, '0a0a'x||copies(' ',6)'COMMENTS:')
  106.             call WordWrap Entry.NumPrompts, 73, '        ', 8, 6OFile
  107.             say f.cls||f.black'The registration form has been saved to' FileName'.'
  108.             say f.lf'Thank you very much for registering.'
  109.         end
  110.     end
  111.     else signal ProblemExit
  112.     options prompt f.lf||f.blue||f.nc'   Press <'f.white||f.bold'Enter'f.norm||f.blue'>'f.norm
  113.     pull .
  114.  
  115. exit 0
  116.  
  117. Failure:
  118. Break_C:
  119. Break_E:
  120. ProblemExit:
  121.     say f.cls||f.blue'Hmm.' f.black'I hope we didn''t run into a problem on that.'
  122.     say 'I hope you''ll consider registering even if I didn''t get this'
  123.     say 'little thing quite right.'
  124.     say f.white'By the way: This will use ReqTools or rexxarplib.library'
  125.     say 'if one of them is available. Otherwise, a far less friendly'
  126.     say 'window is opened for the file request.'
  127.     say '                  '  f.black'Thanks.'
  128.     options prompt f.lf||f.blue||f.nc'   Press <'f.white||f.bold'Enter'f.norm||f.blue'>'f.norm
  129.     pull .
  130.  
  131.     exit 5
  132.  
  133. WordWrap: procedure
  134.     parse arg Line, Length, Heading, Tab, File
  135.     DivPos = lastpos(' ', Line' ', Length) + 1
  136.     call writeln(File, Heading || left(Line, DivPos))
  137.     do while DivPos <= length(Line)
  138.         EndPos = lastpos(' ',Line' ', DivPos + Length+1)
  139.         call writeln(File, copies(' ', Tab) || substr(Line, DivPos, EndPos-DivPos))
  140.         DivPos = EndPos + 1
  141.     end
  142.  
  143. return
  144.  
  145. /*
  146.  * It would be more efficient to set the values directly by
  147.  * a series of assignments. It's both faster and more complex
  148.  * but this provides an example of how in-line data can be read
  149.  * from the program code.
  150.  */
  151.  
  152. SetPrompts: procedure expose RegType. Prompt.
  153.  
  154.     Prompt. = ''
  155.     PNum = 0
  156.     do i = GetLine() by 2
  157.         PNum = PNum + 1
  158.         parse value sourceline(i) with Prompt.PNum
  159.         if Prompt.PNum = '*/' then leave
  160.         parse value sourceline(i+1) with ICode Text
  161.         if ICode = 'Int' then
  162.             interpret 'Prompt.PNum.6Prompt = 'Text
  163.         else
  164.             Prompt.PNum.6Prompt = Text
  165.     end
  166.     return PNum-1
  167.  
  168.     /* See the note to the function SOURCELINE() for an explanation of **
  169.     ** this technique for copying data from the script                 */
  170. SendLine:
  171.     return SIGL + 2
  172. GetLine:
  173.     signal SendLine
  174. /*
  175. Name
  176. .   Enter your full name.
  177. Street Address
  178. .   Include suite/apartment number
  179. City
  180. .   Enter your city only.
  181. State/Province
  182. .   Enter the 2-char. code
  183. Zip/Postal Code
  184.  
  185. Country
  186. .   Enter your country
  187. Network address
  188. .   Enter E-mail address and name of network
  189. Model number
  190. .   Examples: 500, or 1200, or 2000HD
  191. Chip memory
  192. .   Examples: 500K, 1M, 2M, 3M
  193. Fast memory
  194. .   Examples: 0K, 1M, 8M
  195. Hard drive size
  196. .   Examples: 0M, 40M, 120M, 240M
  197. time using ARexx
  198. Int '0a'x'   The following questions concern your level'||'0a'x'   of ARexx expertise.'
  199. your skill level
  200. .   Examples: Expert, Beginner, Novice
  201. programs used with ARexx
  202. Int '0a'x'Include the names of any programs for'||'0a'x'which you will use ARexx to write macros.'
  203. comments about the guide
  204. Int '   Continue typing past the end of line.'||'0a'x'   Text will be wrapped afterwards.'
  205. */
  206.  
  207. GetFile:    procedure expose f.    /* make formatting codes global for syntax: */
  208.         /* If rexxarplib isn't available, this will call syntax:, which **
  209.         ** will ask for a file less politely                            */
  210.     if checklib('rexxreqtools.library',0,-30,37)
  211.         then return rtfilerequest(,,'Save registration form',,'rtfi_flags=freqf_patgad')
  212.     else if checklib('rexxarplib.library',0,-30,0)
  213.         then return 'GetFile'(60,20,,,'Save registration form as:',,PATGAD,,,300)
  214.     else do
  215.         if open(6FWin, 'con:0/8/400/77/ARxxxGuide registration/SCREEN *', W) then do
  216.             call writeln(6FWin, f.blue'Sorry. We couldn''t open a file requester.')
  217.             call writeln(6FWin, f.white'Please enter full path of file.'||'0a'x)
  218.             call writech(6FWin, f.black'File: ')
  219.             FileN = readln(6FWin)
  220.             call close 6FWin
  221.             return FileN
  222.         end
  223.         else
  224.             return ''
  225.     end
  226.  
  227. CheckLib: procedure   /* delete 'procedure' for external function       */
  228.     parse arg LibName, Priority, Offset, Version .
  229.     CheckLib = 1
  230.     if LibName = '' then return 0    /* Must include a library name */
  231.     signal on syntax
  232.  
  233.     if ~show('L', LibName) then do  /* Is the library already on the list? */
  234.           /* Set defaults for ADDLIB() */
  235.        if Priority = '' then Priority = 0
  236.        if Offset = '' then Offset = -30
  237.        if Version = '' then Version = 0
  238.           /* The return from the function doesn't matter, so use  CALL     */
  239.        call addlib(LibName, Priority, Offset, Version)
  240.     end
  241.  
  242.     call FooBarian()
  243.     return 1
  244.  
  245. syntax:
  246.    if CheckLib = 1 then do
  247.       CheckLib = 0
  248.       if rc = 14 then do
  249.          call remlib(LibName)
  250.          return 0
  251.       end
  252.       else
  253.          return 1    /* Function not found, but library was loaded     */
  254.    end
  255.    /* else do standard syntax checking                                 */
  256.